## Deserving Government Assistance? 
## Public Support for Aid to Struggling Firms and Workers
#############################################################
## Chris Witko
## Tobias Heinrich
#############################################################
## 1) Prepare conjoint experiments
#############################################################


## Prepare CCES data
####################
CCES_raw <- read.dta13("data/cces18_common_vv.dta")
CCES <- CCES_raw[, c("commonweight", "birthyr", "race", "gender", "hadjob", "educ")]

## Education
CCES$education_uni <- ifelse(CCES$educ %in% c(5, 6), "4-year university", "Less than 4-year university")

## Gender
CCES$gender <- ifelse(CCES$gender == 1, "Male", "Female")

## Age
CCES$age <- 2018 - CCES$birthyr
CCES <- subset(CCES, age >= 20 & age <= 69)
CCES$age <- cut(x=CCES$age, breaks=c(-Inf, 29, 39, 49, 59, Inf), include.lowest=TRUE,
                labels=c("20s", "30s", "40s", "50s", "60s"))

## Race ethnicity
CCES$race_ethnicity <- mapvalues(x=CCES$race, from=1:8,
                                 to=c("White", "Black", "Hispanic", "Asian", "Native American", "Mixed", "Other",
                                      "Middle Eastern"))
CCES <- subset(CCES, race_ethnicity = c("Middle Eastern", "Other") == FALSE)


## Subset to target population (anyone who had a job in the past 5 years)
CCES <- subset(CCES, hadjob == 1)


## Aggregate for the conjoint
CCES_aggr <- ddply(.data=CCES,
                   .variables=c("age", "gender", "race_ethnicity", "education_uni"), .fun=function(x) data.frame(Prob=sum(x$commonweight)))
CCES_aggr$Prob <- round(CCES_aggr$Prob / sum(CCES_aggr$Prob), di=3)
CCES_aggr$age <- as.character(CCES_aggr$age)
CCES_aggr$race_ethnicity <- as.character(CCES_aggr$race_ethnicity)
CCES_aggr$gender <- as.character(CCES_aggr$gender)


## Draws for Workers conjoint
#############################
N <- 5000
K <- 12
M_vec <- c(NA, NA)
dim_name_vec <- vector("list", 2)
## For workers, subset CCES to those who are full-time/ part-time
u_w_salary <- c("$20,000", "$70,000", "$160,000")
u_w_reason <- c("Operations were moved to a foreign country",
                "Laid off due to foreign competition",
                "Laid off due to domestic competition",
                "Laid off due to company mismanagement",
                "Company was closed due to pandemic public health restrictions",
                "Fired for poor performance",
                "Job was replaced by technology (like robot, artificial intelligence)",
                "Laid off due to economic recession")

dim_names <- c("Reason for job loss", "Salary", "Gender", "Age", "Race/ ethnicity", "Education")
M <- length(dim_names)
M_vec[1] <- M
dim_name_vec[[1]] <- dim_names


## Make storage
draw_workers <- data.frame(W_attr_name_1=rep("", N))
for(m in 2:M)
{
  draw_workers$X <- ""
  colnames(draw_workers)[which(colnames(draw_workers) == "X")] <- paste0("W_attr_name_", m)
}
for(k in 1:K)
{
  for(j in 1:2)
  {
    for(m in 1:M)
    {
      draw_workers$X <- ""
      colnames(draw_workers)[which(colnames(draw_workers) == "X")] <- paste0("W_attr_R", k, "_S",
                                                                             ifelse(j == 1, "L", "R"),
                                                                             "_A", m)
    }
  }
}


## Make draws
for(i in 1:N)
{
  tmp <- array("", dim=c(K, 2, M))
  for(k in 1:K)
  {
    demo <- CCES_aggr[sample(1:nrow(CCES_aggr), size=2, prob=CCES_aggr$Prob), ]
    tmp[k, , 1] <- sample(u_w_reason, size=2)
    tmp[k, , 2] <- sample(u_w_salary, size=2)
    tmp[k, , 3] <- c(demo$gender[1], demo$gender[2])
    tmp[k, , 4] <- c(demo$age[1], demo$age[2])
    tmp[k, , 5] <- c(demo$race_ethnicity[1], demo$race_ethnicity[2])
    tmp[k, , 6] <- c(demo$education_uni[1], demo$education_uni[2])
  }
  
  ## Change attribute order
  this_order <- sample(1:length(dim_names), size=length(dim_names))
  tmp <- tmp[, , this_order]
  this_dim_names <- dim_names[this_order]
  
  ## Insert into draws
  for(m in 1:M)
  {
    draw_workers[i, paste0("W_attr_name_", m)] <- dim_names[this_order][m]
    
    for(k in 1:K)
    {
      for(j in 1:2)
      {
        draw_workers[i, paste0("W_attr_R", k, "_S", ifelse(j == 1, "L", "R"),  "_A", m)] <- tmp[k, j, m]
      }
    }
  }
}

## Save to disk
write(x=toJSON(x=draw_workers, dataframe='rows', pretty=TRUE),
      file="output/Conjoint_workers.json")


## Draws for Firms conjoint
###########################
## For workers stats, subset CCES to those who are full-time/ part-time
u_f_CEO_salary <- c("$200,000", "$2 million", "$10 million")
u_f_salary <- c("$20,000", "$70,000", "$160,000")
u_f_reason <- c("Competition due to superior use of technology (like robots, artificial intelligence)",
                "Foreign competition due to lower labor cost",
                "Mismanagement", 
                "Operations closed due to pandemic public health restrictions",
                "Economic recession")

## From Census
## https://www.census.gov/data/tables/2018/econ/susb/2018-susb-annual.html
u_f_industry <- data.frame(what_raw=c("Professional, Scientific and Technical",
                                  "Construction", "Other Services", 
                                  "Healthcare and Social Assistance",
                                  "Retail Trade", "Accommodation and Food Services",
                                  "Administrative Support and Waste and Management and Remediation Services",
                                  "Real Estate and Rental and Leasing",
                                  "Wholesale Trade", "Manufacturing",
                                  "Finance and Insurance", 
                                  "Transportation and Warehousing",
                                  "Arts, Entertainment and Recreation"),
                           what_pretty=c("OMIT", "Construction", "OMIT", "Health care",
                                         "Retail", "Travel and food services",
                                         "OMIT", "Real estate and rental",
                                         "Wholesale trade", "Manufacturing", "Finance and insurance",
                                         "Transportation and warehousing",
                                         "Arts, entertainment, recreation"),
                           p=c(0.135, 0.118, 0.115, 0.109, 0.1057, 0.033, 0.0579, 
                               0.05282, 0.048, 0.041, 0.0393, 0.03, 0.0221))
u_f_industry <- subset(u_f_industry, what_pretty != "OMIT")         
u_f_industry$p <- u_f_industry$p / sum(u_f_industry$p)
                             
                             
u_f_size <- data.frame(what_pretty=c("Less than 5", "Between 5 and 9", "Between 10 and 19", "Between 20 and 99", 
                                     "Between 100 and 499", "500 or more"),
                       p=c(0.61, 0.17, 0.11, 0.09, 0.02, 0.01))
u_f_size$p <- u_f_size$p / sum(u_f_size$p)

dim_names <- c("CEO pay", "Reason for struggle", "Typical worker salary", "Typical worker age",
               "Typical worker race/ ethnicity", "Industry", "Number of workers", "Typical worker education")
M <- length(dim_names)
M_vec[2] <- M
dim_name_vec[[2]] <- dim_names


## Make storage
draw_firms <- data.frame(F_attr_name_1=rep("", N))
for(m in 2:M)
{
  draw_firms$X <- ""
  colnames(draw_firms)[which(colnames(draw_firms) == "X")] <- paste0("F_attr_name_", m)
}
for(k in 1:K)
{
  for(j in 1:2)
  {
    for(m in 1:M)
    {
      draw_firms$X <- ""
      colnames(draw_firms)[which(colnames(draw_firms) == "X")] <- paste0("F_attr_R", k, "_S",
                                                                             ifelse(j == 1, "L", "R"),
                                                                             "_A", m)
    }
  }
}


## Make draws
for(i in 1:N)
{
  tmp <- array("", dim=c(K, 2, M))
  for(k in 1:K)
  {
    demo <- CCES_aggr[sample(1:nrow(CCES_aggr), size=2, prob=CCES_aggr$Prob), ]
    tmp[k, , 1] <- sample(u_f_CEO_salary, size=2)
    tmp[k, , 2] <- sample(u_f_reason, size=2)
    tmp[k, , 3] <- sample(u_f_salary, size=2)
    tmp[k, , 4] <- c(demo$age[1], demo$age[2])
    tmp[k, , 5] <- c(demo$race_ethnicity[1], demo$race_ethnicity[2])
    tmp[k, , 6] <- sample(u_f_industry$what_pretty, size=2,
                          prob=u_f_industry$p)
    tmp[k, , 7] <- sample(u_f_size$what_pretty, size=2, prob=u_f_size$p)
    tmp[k, , 8] <- c(demo$education_uni[1], demo$education_uni[2])
  }
  
  ## Change attribute order
  this_order <- sample(1:length(dim_names), size=length(dim_names))
  tmp <- tmp[, , this_order]
  this_dim_names <- dim_names[this_order]
  
  ## Insert into draws
  for(m in 1:M)
  {
    draw_firms[i, paste0("F_attr_name_", m)] <- dim_names[this_order][m]
    
    for(k in 1:K)
    {
      for(j in 1:2)
      {
        draw_firms[i, paste0("F_attr_R", k, "_S", ifelse(j == 1, "L", "R"),  "_A", m)] <- tmp[k, j, m]
      }
    }
  }
}

## Save to disk
write(x=toJSON(x=draw_firms, dataframe='rows', pretty=TRUE), file="output/Conjoint_firms.json")


## Make auxiliary .csv for Qualtrics' loop & merge
##################################################
for(j in 1:2)
{
  tmp <- matrix("", K, 3*M_vec[j])
  
  for(m in 1:M_vec[j])
  {
    tmp[, m] <- paste0("${e://Field/", ifelse(j == 1, "W", "F"), "_attr_name_", m, "}")
  }

  count <- M_vec[j] + 1
  for(v in 1:2)
  {
    for(m in 1:M_vec[j])
    {
      tmp[, count] <- paste0("${e://Field/", paste0(ifelse(j == 1, "W", "F"), "_attr_R", 1:K, "_S", ifelse(v == 1, "L", "R"),  "_A", m), "}")
      count <- count + 1
    }
  }
  
  write.csv(x=tmp, file=paste0("output/Qualtrics_LM_", ifelse(j == 1, "workers", "firms"), ".csv"))
}      


## Put together information for demographic batches in survey recruiting
########################################################################
CCES <- CCES_raw[, c("commonweight", "birthyr", "ideo5")]
CCES$age <- cut(x=2018 - CCES$birthyr, breaks=c(-Inf, 24, 34, 44, 54, 64, Inf))
CCES$ideo5 <- mapvalues(x=CCES$ideo5,
                        from=1:6,
                        to=c(rep("Liberal", 2), "Moderate", rep("Conservative", 2), "DKNO"))
CCES$ideo5[is.na(CCES$ideo5) == TRUE] <- "DKNO"

tmp <- ddply(.data=CCES, .variables=c("ideo5", "age"), .fun=function(x) data.frame(Prob=sum(x$commonweight)))
tmp$Prob <- tmp$Prob / sum(tmp$Prob)

budget <- 1000
tmp$Allocation <- tmp$Prob * budget * 0.8
tmp$SampSize <- tmp$Allocation / (1.3 * 0.8)

sum(tmp$SampSize)


## Garbage collection
#####################
rm(list=ls())
